perm filename MOVE.FAI[NEW,LCS]4 blob
sn#271087 filedate 1977-03-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE MOVE
C00021 ENDMK
C⊗;
TITLE MOVE
ENTRY GETPTS,MOVIT,OUTLIM,COPYIT,UPDN,STFCH,DELETE,NOIR
ENTRY SLEND,POSIT,NOTAIL
EXTERNAL LOOP,RTLINE,DL,DPY,DPYNEW,.COMM.,XRN,KJY,PTR,POSI
EXTERNAL SCM,AMOD,RMOD,RINP
K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
; SUBROUTINE GETPTS
; DIMENSION N(500),NP(500)
; COMMON/XRN/RN(4000) /KJY/ K,J
; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
; 1/PTR/PWDS(250),ITEM,LL,I,IX
; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
; 1,(R6,RJQ(4)),(N,RN(2500)),(NP,RN(3000))
GETPTS: 0 ;CALL GETPTS(N)
SETZ J, ; J=0
SETZ K, ; K=0
MOVE JJ2,POSI+=8
MOVE R2,.COMM.
MOVE X,@(16)
SOS X
MOVEI M,PTR ; DO 1 M=1,ITEM
ADDI M,(X)
G1: AOJ X,
MOVE L,(M)
MOVEI R,XRN(L) ;L=PWDS(M)
MOVE 1,1(R) ;RN(L+2)
CAML R2,[=8.0] ;IF R2.GE.8 LOOK AT ALL STAVES
JRST GZ
CAME R2,1
JRST GX
GZ: MOVE A,.COMM.+7 ;RY=RN(L+1)
JUMPLE A,G9 ;F(R6.LE.0)GO TO 9
CAME A,(R)
JRST GX
; CHECK CODE NUM
G9: MOVE A,2(R) ;IF(R6.NE.RY)GO TO 1
CAMG A,.COMM.+6 ;9 IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
CAMGE A,.COMM.+5 ;R4
JRST G2
CAMLE JJ2,X
MOVE JJ2,X ;IF(M.LT.JJ2)JJ2=M
AOJ J,
; IN LIMITS?
MOVEI A,RINP+=399(J) ;J=J+1
MOVEI 0,(L)
AOJ K, ;K=K+1
MOVEI 1,RINP+=649(K)
MOVEM 0,(1)
ADDI 0,3 ;N(J)=L+3
MOVEM 0,RINP+=399(J)
; NP IS FOR USE IN JUSTIFY ROUTINE
G2: MOVE RY,(R) ;2 IF(RY.LT.4)GO TO 1
CAML RY,[=4.0]
CAMLE RY,[=7.0]
JRST GX ;IF(RY.GT.7)GO TO 1
; TWO-ENDED ITEM?
MOVE RZ,-1(R) ;RZ=RN(L)
; WD CNT
KIFIX RY,RY
XCT TBL-4(RY) ; NEXT REPLACES THE ABOVE.
JRST G5
JRST GX
TBL: JRST G4
JRST G5
JRST G6
CAMG RZ,[4.0]
G4: CAMG RZ,[=2.0] ;7 IF(RZ.GT.3)GO TO 5
JRST GX
JRST G5 ;GO TO 1
G6: CAMGE RZ,[=8.0] ;6 IF(RZ.LT.8)GO TO 8
JRST G8
SKIPL 6(R) ;IF(R7)GO TO 8
SKIPN =9(R) ;IF(R10.EQ.0)GO TO 8
JRST G8
MOVE A,7(R) ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
CAMG A,.COMM.+6
CAMGE A,.COMM.+5
JRST G8
CAMLE JJ2,X
MOVE JJ2,X
AOJ J,
; IN LIMITS?
MOVEI 0,=8(L) ;J=J+1
MOVEM 0,RINP+=399(J)
G8: CAML RZ,[=7.0] ;8 IF(RZ.LT.7)GO TO 5
SKIPG A,8(R) ; R9
JRST G5
SKIPE 7(R) ; R8 USE R9 IF R9<0 AND (R8≠0 OR R7<0)
JRST .+3
SKIPL 6(R) ; R7
JRST G5
CAMG A,.COMM.+6
CAMGE A,.COMM.+5 ;R4
JRST G5
CAMLE JJ2,X
MOVE JJ2,X
AOJ J, ;J=J+1
; IN LIMITS?
MOVEI 0,=9(L)
MOVEM 0,RINP+=399(J)
G5: MOVE A,5(R)
CAMG A,.COMM.+6
CAMGE A,.COMM.+5 ;R4
JRST GX
CAMLE JJ2,X
MOVE JJ2,X
AOJ J,
; IN LIMITS?
MOVEI 0,6(L) ;5 IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
MOVEM 0,RINP+=399(J)
GX: CAMGE X,PTR+=250 ;1 CONTINUE
AOJA M,G1
MOVEM JJ2,POSI+=8
MOVEM J,KJY+1
MOVEM K,KJY
JRA 16,1(16)
; SUBROUTINE MOVIT
; DIMENSION N(500)
; COMMON/XRN/RN(4000) /KJY/ DONT,J
; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R9,RJQ(7))
; 1,(R6,RJQ(4)),(N,RN(2500)),(R8,RJQ(6))
MOVIT: 0 ;RDIS=(R9-R8)/(R5-R4)
MOVE R,.COMM.+=10
FSBR R,.COMM.+=9
MOVE RY,.COMM.+6
FSBR RY,.COMM.+5
FDVR R,RY
MOVEI L,RINP+=400 ; DO 1 K=1,JS
SETZ K,
MOVE 0,.COMM.+=10 ; SET UP R9
M1: MOVE X,L ; L=N(K)
MOVE A,(X)
MOVEI R2,XRN(A) ;RA=RN(L)
MOVEI RZ,(R2)
MOVE R2,-1(R2)
CAML R2,.COMM.+5 ;IF(OUTLIM(R4,R5,RA))GO TO 1
CAMLE R2,.COMM.+6
JRST MX
JUMPE 0,M2 ;IF(R9.NE.0)RA=(RA-R4)*RDIS
FSBR R2,.COMM.+5
FMPR R2,R
M2: FADR R2,.COMM.+=9 ; RN(L)=R8+RA
MOVEM R2,-1(RZ)
MX: AOJ K, ;1 CONTINUE
CAMGE K,KJY+1
AOJA L,M1
JRA 16,(16)
OUTLIM: 0 ; FUNCTION OUTLIM(I,J)
SETO 0, ; OUTLIM=-1
; IF(RN(I+J).LT.R4)RETURN
MOVE 2,@(16)
ADD 2,@1(16)
MOVE 2,XRN-1(2)
CAMGE 2,.COMM.+5
JRA 16,2(16)
; IF(RN(I+J).GT.R5)RETURN
CAMG 2,.COMM.+6
SETZ 0, ; OUTLIM=0
JRA 16,2(16)
;***** COPYIT
;; TITLE COPYIT
; SUBROUTINE COPYIT
; COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
; 1/PTR/PWDS(250),ITEM,LL,I,IX
; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
; 1,(R6,RJQ(4)),(N,RN(2500))
STFCH: 0
SETO 13, ;FLAG FOR STFCH ROUTINE
JRST .+3
COPYIT: 0
SETZ 13, ;MAKE SURE IT'S 0
SETZ 7, ;IM=ITEM
MOVE 15,PTR+=250 ; AC7 IS K-1
SOJ 15, ;(ITEM-1)
CP1: JSA 16,RTLINE ;DO 1 K=1,IM
JUMP PTR(7) ;L=PWDS(K)
JUMPL CPY ; IF(RTLINE(L))GO TO 1
JSA 16,OUTLIM ;IF(OUTLIM(L,3))GO TO 1
JUMP PTR(7)
JUMP [3]
JUMPL CPY
MOVE 11,PTR(7) ; NOW L IS AC11
MOVE 10,.COMM.+7 ;IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
JUMPE 10,CP3
CAME 10,XRN(11)
JRST CPY
CP3: JUMPL 13,STF2 ; SKIP OVER FOR STFCH ROUTINE
KIFIX 12,XRN-1(11) ;M=RN(L)+2
ADDI 12,2
JSA 16,LOOP ;CALL LOOP(0,M,1,I,L,RN)
JUMP [0]
JUMP 12
JUMP [1]
JUMP PTR+=252
JUMP 11
JUMP XRN
AOS PTR+=250 ;ITEM=ITEM+1
MOVE 13,PTR+=250
MOVE 11,PTR-1(13) ;L=PWDS(ITEM)
STF2: MOVE 14,.COMM.+=8 ;RN(L+2)=R7
MOVEM 14,XRN+1(11)
JUMPGE 13,CP2
MOVE 0,7
AOJ
CAMGE POSI+=8
MOVEM POSI+=8 ; IF(K.LT.JJ2)JJ2=K
JRST CPY
CP2: CAMGE 13,POSI+=8 ;IF(ITEM.LT.JJ2)JJ2=ITEM
MOVEM 13,POSI+=8
AOJ 12, ;I=I+M+1
ADD 12,PTR+=252
MOVEM 12,PTR+=252
MOVEM 12,PTR(13) ;PWDS(ITEM+1)=I
CPY: CAMGE 7,15 ;1 CONTINUE
AOJA 7,CP1
JUMPL 13,.+3
MOVE 7,.COMM.+=8 ;R2=R7
MOVEM 7,.COMM. ;DOES THIS MATTER FOR STFCH}
JRA 16,(16) ;END
;SUBROUTINE STFCH
;INTEGER PWDS
;COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
;1/PTR/PWDS(250),ITEM,LL,I,IX
;EQUIVALENCE (R7,RJQ(5)),(R6,RJQ(4))
;DO 1 K=1,ITEM
;L=PWDS(K)
;IF(RTLINE(L))GO TO 1
;IF(OUTLIM(L,3))GO TO 1
;IF(RN(L+1).NE.R6.AND.R6.NE.0)GO TO 1
;C DIDN'T MATCH THE CODE NUM.
;IF(JJ2)JJ2=K
;RN(L+2)=R7
;1 CONTINUE
;END
UPDN: 0 ;SUBROUTINE UPDN(NST)
;INTEGER PWDS
;COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
;1/PTR/PWDS(250),ITEM,LL,I,IX
MOVE 7,@(16) ;EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
SOJ 7, ;1,(R6,RJQ(4))
MOVE 15,PTR+=250 ; AC7 IS K-1
SOJ 15, ;(ITEM-1)
UPDN0: JSA 16,RTLINE ;DO 1 K=NST,ITEM
JUMP PTR(7) ;L=PWDS(K)
JUMPL UPDN1 ; IF(RTLINE(L))GO TO 1
MOVE 11,PTR(7) ;RY=RN(L+1) -- 11 IS L
MOVE 12,XRN(11) ;IF(RY.GT.16)GO TO 1
CAMG 12,[16.0] ; AC12=RY
CAME 12,[8.0] ;IF(RY.EQ.8)GO TO 1
CAMN 12,[3.0] ;IF(RY.EQ.3)GO TO 1
JRST UPDN1
CAMN 12,.COMM.+7 ;IF(RY.EQ.R6)GO TO 10
JRST UPDN10
SKIPE .COMM.+7 ;IF(R6.NE.0)GO TO 1
JRST UPDN1
UPDN10: CAME 12,[4.0] ; DIDN'T MATCH THE CODE NUM.
JRST UPDN11 ;10 ;IF(RY.NE.4)GO TO 11
MOVE 2,XRN-1(11) ;IF(RN(L).LT.3)GO TO 1
CAMGE 2,[3.0]
JRST UPDN1 ; A BAR LINE
UPDN11: JSA 16,OUTLIM ;11 IF(OUTLIM(L,3))GO TO 2
JUMP PTR(7)
JUMP [3]
JUMPL UPDN2
MOVE 2,.COMM.+=12 ;RN(L+4)=RN(L+4)+R11
FADRM 2,XRN+3(11)
;IF(JJ2)JJ2=K
MOVE 0,7
AOJ
CAMGE POSI+=8
MOVEM POSI+=8 ;IF(K.LT.JJ2)JJ2=K
UPDN2: CAML 12,[4.0] ;2 ;IF(RY.LT.4)GO TO 1
CAML 12,[7.0] ;IF(RY.GE.7)GO TO 1
JRST UPDN1 ; NO WIGGLE ON TRILL
CAME 12,[4.0] ;IF(RY.NE.4.)GO TO 12
JRST UPDN12
MOVE XRN+4(11) ;IF(RN(L+5).EQ.50)GO TO 1
CAMN [50.0] ;AC0 IS RN(L+5)
JRST UPDN1 ; CRESC. OR BOX
UPDN12: JSA 16,OUTLIM ;12 ;IF(OUTLIM(L,6))GO TO 1
JUMP PTR(7)
JUMP [6]
JUMPL UPDN1
MOVE 3,.COMM.+=12 ;RN(L+5)=RN(L+5)+R11
FADRM 3,XRN+4(11)
;IF(JJ2)JJ2=K
MOVE 0,7
AOJ
CAMGE POSI+=8
MOVEM POSI+=8 ;IF(K.LT.JJ2)JJ2=K
UPDN1: CAMGE 7,15 ;1 ;CONTINUE
AOJA 7,UPDN0
JRA 16,1(16) ;END
;SUBROUTINE DELETE
;IMPLICIT INTEGER(A-Q,S-Z)
;COMMON/DL/X22,SAVER,NAME
;COMMON /XRN/RN(4000)
;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(15),R6,DEL,X,JY,K
;COMMON/PTR/PWDS(250),ITEM,L,I,IX
;COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
DELETE: 0 ;EQUIVALENCE (ST2,ST(2))
MOVE 15,PTR+=252
MOVEM 15,PTR+=253
MOVE 12,DPY+=4250 ;171 IX=I 15 IS IX
KIFIX 14,XRN-1(12) ;L=RN(MEDIT)+3.0
ADDI 14,3 ;AC14 IS L
; SIZE OF DELETION
SUB 15,14 ;I=IX-L
MOVEM 15,PTR+=252
JSA 16,LOOP ;CALL LOOP(MEDIT,I,1,0,L,RN)
JUMP DPY+=4250
JUMP PTR+=252
JUMP [1]
JUMP [0]
JUMP 14
JUMP XRN
MOVE 7,DL ;JY=WDS(X22+1)-WDS(X22)
MOVE 13,DPY+=4000(7)
SUB 13,DPY+=3999(7) ;JY IS 13, X22 IS 7
MOVEI 10,2
ADD 10,DPY+=3999(7) ;WDS(X22)+2
MOVE 15,PTR+=250 ;15 IS ITEM (X)
JSA 16,LOOP ;CALL LOOP(WDS(X22)+2,WDS(X),1,0,JY,ST)
JUMP 10
JUMP DPY+=3999(15)
JUMP [1]
JUMP [0]
JUMP 13
JUMP DPY
MOVE 12,7 ;K=X22
DELE: MOVE 11,12 ;194 N=K+1
AOJ 11, ;N IS 11 K IS 12
MOVE 2,DPY+=4000(11) ;WDS(N)=WDS(N+1)-JY
SUB 2,13
MOVEM 2,DPY+=3999(11)
MOVE 2,PTR-1(11) ;PWDS(K)=PWDS(N)-L
SUB 2,14
MOVEM 2,PTR-1(12)
MOVE 12,11 ;K=N
CAMGE 12,15 ;IF(K.LT.X)GO TO 194
JRST DELE ; ABOVE RESHUFFLES POINTER ARRAYS. X=ITEM+1
SOS PTR+=250 ;ITEM=ITEM-1
MOVE 2,PTR+=250
CAMLE 7,PTR+=250 ;IF(X22.GT.ITEM)X22=ITEM
MOVEM 2,DL
MOVEM 2,.COMM.+2 ;J2=ITEM
SOS PTR+=250 ;ITEM=ITEM-1
MOVE 2,DPY+=3999(2) ;ST2=WDS(J2)
MOVEM 2,DPY+1
JSA 16,DPYNEW ;271 CALL DPYNEW
JRA 16,(16)
NOIR: 0
JRA 16,1(16) ; DUMMY ******
SLEND: 0 ; SUBROUTINE SLEND
MOVE 8,[8.0] ;INTEGER PWDS
MOVE 7,SCM+=80 ;C TO FIND END POINTS OF STAVES
MOVE 4,[4.0];COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,
; 1 DMAX,UMAX,AA,JMAX,X,Y,BB,RNX(1982)
; 1/SCM/V(78),I,LCNT,STAFF,LIST(200),REND/PTR/PWDS(250),ITEM,LL,IS,IX
SETZ 5, ;DO 1 K=1,ITEM
SLN1: MOVE 6,PTR(5) ;L=PWDS(K)
;IF(RN(L+1).NE.8)GO TO 1
CAMN 8,XRN(6) ;C FOUND A STAFF ;IF(RN(L+2).NE.STAFF)GO TO 1
CAME 7,XRN+1(6) ;C GOT THE RIGHT ONE
JRST SLN1X ;IF(IT)GO TO 2
SKIPGE RMOD+=10 ;POS=202
JRST SLN2 ;C NOW CHECK LEFT SIDE OF STAFF
MOVE 15,[202.0] ;IF(RN(L).LT.4)RETURN
CAML 4,XRN-1(6) ;P6 WASN'T MENTIONED - SO IT =200
JRST SLN3
;POS=RN(L+6)+2
MOVE 15,XRN+5(6) ;IF(POS.EQ.2)POS=202
FADR 15,[2.0] ;RETURN
CAMN 15,[2.0] ;2 POS=RN(L+3)-2.3
MOVE 15,[202.0] ;RETURN
JRST SLN3 ;1 CONTINUE
SLN2: MOVE 15,XRN+2(6) ;END
FSBR 15,[2.3]
SLN3: MOVEM 15,RMOD+=11
JRA 16,(16)
SLN1X: AOS 5
CAMGE 5,PTR+=250
JRST SLN1
JRA 16,(16)
POSIT: 0 ; FUNCTION POSIT(V)
MOVE 15,@(16) ; COMMON/XRN/RN(4000)
SKIPGE 15 ; DIMENSION POSNT(0/82)
MOVNS 15 ; EQUIVALENCE (POSNT,RN(3801))
; 1,(A,RN(3884)),(K,RN(3885))
KIFIX 14,15 ; IF(V)V=-V
; REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
JSA 16,AMOD ; K=V
JUMP 15 ; A=POSNT(K)
JUMP [1.0] ;POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
; TYPE /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
MOVE 2,RINP+=801(14) ; END
FSBR 2,RINP+=800(14)
FMPR 0,2
FADR 0,RINP+=800(14)
JRA 16,1(16)
NOTAIL: 0 ;FUNCTION NOTAIL(X)
SETZ ;NOTAIL=0
MOVM 2,@(16) ;X=ABS(X)
CAML 2,[0.56] ;IF(X.LT..56.OR.X.EQ..75)RETURN
CAMN 2,[0.75]
JRA 16,1(16)
CAME 2,[0.875] ;IF(X.EQ..875.OR.X.EQ..6)RETURN (8.. OR 10. )
CAMN 2,[0.6]
JRA 16,1(16)
SETO ;NOTAIL=-1
JRA 16,1(16)
END